﻿unit MathModule;

interface

uses
  //Windows, math, gost, Dialogs, Sysutils, classes;

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, gost,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TFilmInput = record
    a: extended; {Входное межосевое расстояние передачи}
    P1: extended; {Мощность на ведущем шкиве}
    n1: extended; {Число оборотов ведущего шкива}
    up: extended; {Проектное передаточное число}
    d1: extended; {Диаметр малого шкива}
    Q: word; {Угол наклона передачи к горизонту}
    Tip_nat: boolean; {Натяжение ремня}
    Cp: extended; {Коэффициент режима работы}
    Sdelta: extended; {Толщина ремня}
    Tip_pl: word;
    alfa_min: extended; {Минимально допустимый угол обхвата}
    nyu_max: extended; {Максимально допустимое число пробегов}
    V_max: extended; {Максимально допустимая скорость ремня}
    f_pr: extended; {Приведенный коэффициент трения}
  end;

type
  TFilmOutput = record
    a: extended; {Фактическое межосевое расстояние передачи}
    d2: extended; {Диаметр большого шкива}
    alfa: extended; {Угол охвата ремнем меньшего шкива}
    Vol: extended; {Объем передачи}
    Lh: extended; {долговечность}
    d1: extended; {Диаметр малого шкива}
    Fb: extended; {Нагрузка на вал от натяжения ветвей ремня}
    l: extended; {Длина ремня}
    bs: extended; {Ширина шкива}
    u: extended; {Фактическое передаточное число}
    n2: extended; {Число оборотов ведомого шкива}
    V: extended; {Линейная скорость ремня}
    nyu: extended; {Число пробегов ремня в секунду}
    Ft: extended; {Окружное усилие в передаче}
    F0: extended; {Сила предварительного натяжения ремня}
    //z: byte; {Число слоев кордткани}
    b: extended; {Ширина ремня}
  end;

type
  TFilmOutputs = array of TFilmOutput;

type
  Tcalcfilm = class
    FCologea: TFilmOutputs;
    //FColpos : integer;
    //FColsize : integer;
    constructor create(filminput: TFilmInput); overload;
    procedure FilmMakeVersions(Input: TFilmInput; var Gears: TFilmOutputs);
    PROCEDURE FilmMake(Input: TFilmInput; var Output: TFilmOutput);
    procedure showcolpos(inp: integer; var colpos: integer);
    procedure showsizecol(col: TFilmOutputs; var cs: integer);
    procedure clearlist;
    destructor destroy;
    property Cologea: TFilmOutputs read FCologea write FCologea;
    //property colpos: Tfilmoutputs read FCologea write FCologea;
  end;


  //PROCEDURE FilmMakeVersions(Input: TFilmInput; var Gears: TFilmOutputs);

  //Плоскопленочная
  //PROCEDURE FilmMake(Input: TFilmInput; var Output: TFilmOutput);

const
  erDiam = 1;
  erWidth = 1;
  erAngle = 2;
  erSpeed = 3;
  erRunway = 4;
  erLength = 5;
  erWidthStrap = 6;
  erStraps = 6;
  erDistance = 7;

implementation

uses Unit1;

{Tcalcfilm}

procedure Tcalcfilm.clearlist;
begin
  setlength(FCologea, 0);

end;

constructor Tcalcfilm.create(filminput: TFilmInput);
begin
  inherited create;
end;

procedure Tcalcfilm.FilmMake(Input: TFilmInput; var Output: TFilmOutput);

{BEGIN
 Diameter;
 Geometric;
 Kinematic;
 Wheel;
 Forces;
 END;}


//PROCEDURE Diameter;

Var
  id: integer;

  id2: integer;
  l_max: extended;

  C: extended;

  b_max, p0, C_alfa, C_V, C_Q: extended;
  ib_max, ib_min: integer;

  F1, F2, alfa_c, m, Sigma_E, q1: extended;

  {F1 - натяжение ведущей ветви;
   F2 - натяжение ведомой ветви;
   Fb - давление на валы ремня;
   F0 - усилие предварительного натяжения;
   Ft - окружное усилие в передаче}
Const
  f = 0.25;

begin {begin}
  BEGIN
    {----------------- Расчет диаметра ведущего шкива -------------------}

    if Input.d1 = 0 then
     begin
     try
      Input.d1 := TArrayD[Round(Array_plen[Input.Tip_pl, 2])]
     except
        on E: Exception do
          raise Exception.create
            ('[TFilmBelt.Calculate] Не удалось округлить диаметр малого шкива (d1) до ближайшего значения из ряда линейных размеров');
      end;
     end
    else
      TruncGost(TArrayD, 1, 38, Input.d1, Input.d1, id);

  END; {--------- Конец расчета d1 --------------------------------------}

  //PROCEDURE Geometric;

  //Var

  BEGIN

    {----------------------- Расчет геометрии передачи ------------------------}
    l_max := TArrayLP[Round(Array_plen[Input.Tip_pl, 7])];

    try

      if Input.up > 1 then
        Output.d2 := Input.d1 * Input.up
      else
        Output.d2 := Input.d1 / Input.up;

      if Output.d2 >= TArrayD[38] then

      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте диаметра ведомого шкива (d2), передаточное отношение (up) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива (d2)');
      end;

      begin
        //showmessage('d2 >=tarrayd');
        //ErrorCode := erDiam;
        //Exit;
      end;

      try
        RoundGOST(TArrayD, 1, 38, Output.d2, Output.d2, id2);
      except
        on E: Exception do
          raise Exception.create
            ('[TFilmBelt.Calculate] Не удалось округлить диаметр ведомого шкива (d2) до ближайшего значения из ряда линейных размеров');
      end;

      try
        if Input.a = 0 then
          Output.a := 1.5 * (Input.d1 + Output.d2);

        Output.l := 2 * Output.a + Pi * (Input.d1 + Output.d2) / 2 +
          sqr(Output.d2 - Input.d1) / (4 * Output.a);
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте факт межосевого растояния (a), передаточное отношение (up) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте факт межосевого растояния (a)');
      end;

      if Output.l > l_max then
      begin
        //showmessage('Output.l > l_max');
        //ErrorCode := erLength;
        //Exit;
      end;

      try
      RoundGOST(TArrayLP, 1, Round(Array_plen[Input.Tip_pl, 7]), Output.l,
        Output.l, id2);
      except
        on E: Exception do
      raise Exception.Create
        ('[TNarrowVeeBelt.Calculate] Не удалось округлить тип пленки (Tip_pl) до ближайшего значения из ряда линейных размеров');

      end;

      try
        Output.a := (Output.l - Pi * (Input.d1 + Output.d2) / 2) / 4 +
          sqrt(sqr(Output.l - Pi * (Input.d1 + Output.d2) / 2) - 2 *
          sqr(Input.d1 - Output.d2)) / 4;
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте факт межосевого растояния (a), передаточное отношение (up) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте факт межосевого растояния (a)');
      end;

      if Output.a <> 0 then
        try
          Output.alfa := 180 - (Output.d2 - Input.d1) * 57 / Output.a;
        except
          on E: EZeroDivide do
            raise EZeroDivide.create
              ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте факт межосевого растояния (a), передаточное отношение (up) не может быть равно нулю');
          else
            raise Exception.create
              ('[TFilmBelt.Calculate] Ошибка при расчёте факт межосевого растояния (a)');
        end;

      //if Output.alfa < Input.alfa_min then
      //showmessage('output.alfa < input.alfa_min')
      //ErrorCode := erAngle;

    END; {------------------------------------------------------}

    //PROCEDURE Kinematic;

    {--------- Расчет кинематических параметров передачи -------}
    //Var

    BEGIN

      C := 0.99;
      try
        Output.u := Output.d2 / (C * Input.d1);
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (u), (d1) не может быть равно нулю');
      end;

      try
        Output.n2 := Input.n1 * Input.d1 * C / Output.d2;
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (n2), (d2) не может быть равно нулю');
      end;

      if Input.up > 1 then
        Output.V := Pi * Input.d1 * Input.n1 / 60000
      else
        Output.V := Pi * Output.d2 * Input.n1 / 60000;

      //if Output.V > Input.V_max then ;
      //showmessage('output.V > input.V_max');
      //ErrorCode := erSpeed;

      Output.nyu := 1000 * Output.V / Output.l;
      //if Output.nyu > Input.nyu_max then;
      {ErrorCode:=erRunway;
      }

    END; {-------- Конец процедуры Kinematic-----------------------}

    //PROCEDURE Wheel;

    {------------- Расчет ширины ремня, геометрии шкива ------------}
    //Var

    BEGIN

    try
      b_max := Array_plen[Input.Tip_pl, 8];
      p0 := Array_plen[Input.Tip_pl, 5];
      ib_max := Round(Array_plen[Input.Tip_pl, 4]);
      ib_min := Round(Array_plen[Input.Tip_pl, 3]);
      except
    on E: Exception do
      raise EAccessViolation.Create
        ('[Tcalc.makeversion] Подбор значений из таблиц вызвал ошибку, неверно задан номер сечения (SectionIndex)');
  end;

      {коэффициент угла обхвата}

      try
        C_alfa := 1 - 0.003 * (180 - Output.alfa);
        C_V := 1.04 - 0.0004 * Output.V * Output.V;
      except
        raise Exception.create
          ('[TFilmBelt.Calculate] Ошибка при расчёте  (C_alfa, C_V )');
      end;

      if not Input.Tip_nat then
        case Input.Q of
          0:
            C_Q := 1;
          1:
            C_Q := 0.9;
          2:
            C_Q := 0.8;
        end
      else
        C_Q := 1;
      try
        {тяговое усилие на всю ширину ремня}
        Output.Ft := 1000 * Input.P1 / Output.V;
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (v), передаточное отношение (ft) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива (v)');
      end;

      try
        {ширина ремня}
        Output.b := Output.Ft / (p0 * C_alfa * C_V * Input.Cp * C_Q);
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (b), (p0 * C_alfa * C_V * Input.Cp * C_Q) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте (b)');
      end;

      If Output.b > b_max then
      begin
        //showmessage('ремень б_макс');
        //ErrorCode := erWidthStrap;
        //Exit;
      end
      else
        TruncGost(TArrayBP, ib_min, ib_max, Output.b, Output.b, ib_min);
      Output.bs := TArrayBP[ib_min + 1];
      {Конец процедуры  Shkiw}

    END;

    //PROCEDURE Forces;
    {------------------ Расчет сил ------------------------}

    //Var

    BEGIN

      alfa_c := 0.7 * Output.alfa * Pi / 180;
      m := exp(Input.f_pr * alfa_c);

      try
        F1 := m / (m - 1) * Output.Ft;
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (f1), ((m - 1) * Output.Ft) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива (f1)');
      end;

      F2 := F1 - Output.Ft;
      try
        Output.F0 := Output.Ft / 2 * ((m + 1) / (m - 1));
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (f0), (2 * (2 * ((m + 1) / (m - 1))) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива (f0)');
      end;

      Output.Fb := sqrt(sqr(F1) + sqr(F2) - 2 * F1 * F2 * cos(Output.alfa));
      Output.Vol := (Output.b * (Pi * (sqr(Input.d1) + sqr(Output.d2)) + 4 *
        Input.a * (Input.d1 + Output.d2))) / 8 * 1E-6;
      alfa_c := 0.7 * Output.alfa * Pi / 180;
      q1 := exp(f * alfa_c);
      try
        Sigma_E := 0.1 * q1 * Output.Ft / (Input.Sdelta * Output.b * (q1 - 1)) +
          90 * Input.Sdelta / Input.d1 + 1.2E-3 * sqr(Output.V);
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (Sigma_E), ((Input.Sdelta * Output.b * (q1 - 1)) + 90 * Input.Sdelta / Input.d1 + 1.2E-3 * sqr(Output.V)) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива ((Sigma_E))');
      end;

      try
        Output.Lh := 1.1E5 * Output.l / (Output.V * exp(4 * ln(Sigma_E)));
      except
        on E: EZeroDivide do
          raise EZeroDivide.create
            ('[TFilmBelt.Calculate] Ошибка деления на ноль при расчёте (Lh), ((Output.V * exp(4 * ln(Sigma_E)))) не может быть равно нулю');
        else
          raise Exception.create
            ('[TFilmBelt.Calculate] Ошибка при расчёте диаметра ведомого шкива ((Lh))');
      end;
    END; {------------- Конец процедуры Forces-------------------------}

  end;

  procedure Tcalcfilm.FilmMakeVersions(Input: TFilmInput;
    var Gears: TFilmOutputs);
  var
    CurrGear: TFilmOutput;
    d1x: extended;
    SecIndex, id: integer;
  begin
    setlength(Gears, 0);

    if (Input.Tip_pl <> 0) and (Input.d1 <> 0) then
    begin
      FilmMake(Input, CurrGear);
      setlength(Gears, 1);
      Gears[0] := CurrGear;
    end;

    if (Input.Tip_pl = 0) and (Input.d1 <> 0) then
    begin
      for SecIndex := 1 to 5 do
      begin
        Input.Tip_pl := SecIndex;
        FilmMake(Input, CurrGear);
        setlength(Gears, Length(Gears) + 1);
        Gears[High(Gears)] := CurrGear;
      end;
    end;

    if (Input.Tip_pl <> 0) and (Input.d1 = 0) then
    begin
      Input.d1 := TArrayD[Round(Array_plen[Input.Tip_pl, 2])];
      repeat
        FilmMake(Input, CurrGear);
        Input.d1 := 1.25 * Input.d1;
       try
        RoundGOST(TArrayD, 1, 38, Input.d1, Input.d1, id);
       except
        on E: Exception do
      raise Exception.Create
        ('[TNarrowVeeBelt.Calculate] Не удалось округлить диаметр малого шкива (d1) до ближайшего значения из ряда линейных размеров');
       end;
        setlength(Gears, Length(Gears) + 1);
        Gears[High(Gears)] := CurrGear;
        Form1.Memo1.Lines.Add(FloatToStr(CurrGear.d2));
      until CurrGear.d2 >= TArrayD[38];
    end;

    if (Input.Tip_pl = 0) and (Input.d1 = 0) then
    begin
      for SecIndex := 1 to 5 do
      begin
        Input.d1 := TArrayD[Round(Array_plen[Input.Tip_pl, 2])];
        repeat
          FilmMake(Input, CurrGear);
          Input.d1 := 1.25 * Input.d1;
          try
        RoundGOST(TArrayD, 1, 38, Input.d1, Input.d1, id);
       except
        on E: Exception do
      raise Exception.Create
        ('[TNarrowVeeBelt.Calculate] Не удалось округлить диаметр малого шкива (d1) до ближайшего значения из ряда линейных размеров');
       end;
          setlength(Gears, Length(Gears) + 1);
          Gears[High(Gears)] := CurrGear;
          Form1.Memo1.Lines.Add(FloatToStr(CurrGear.d2));
        until CurrGear.d2 >= TArrayD[38];
      end;
    end;

  end;

  procedure Tcalcfilm.showcolpos(inp: integer; var colpos: integer);
  begin
    colpos := inp;
  end;

  procedure Tcalcfilm.showsizecol(col: TFilmOutputs; var cs: integer);
  begin
    cs := high(col);
  end;

  destructor Tcalcfilm.destroy;
  begin
    inherited;
  end;

end.
